Visual Basic Controls/Visual Basic Controls.iso/vbcontrol/swbback/selectdi.frm

Visual Basic Form | 1999-05-12 | 13.9 KB | 400 lines

VERSION 5.00
Begin VB.Form SelectDirForm
   AutoRedraw      =   -1  'True
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Select Files"
   ClientHeight    =   4170
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6420
   Icon            =   "SelectDirForm.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4170
   ScaleWidth      =   6420
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.Frame Frame2
      Caption         =   "Include Files in this Date Range"
      Height          =   1215
      Left            =   3390
      TabIndex        =   15
      Top             =   2040
      Width           =   2925
      Begin VB.TextBox EndDate
         Height          =   315
         Left            =   810
         TabIndex        =   9
         Top             =   690
         Width           =   1725
      End
      Begin VB.TextBox StartDate
         Height          =   315
         Left            =   810
         TabIndex        =   8
         Top             =   330
         Width           =   1725
      End
      Begin VB.Label Label3
         AutoSize        =   -1  'True
         Caption         =   "To"
         Height          =   195
         Left            =   360
         TabIndex        =   17
         Top             =   750
         Width           =   195
      End
      Begin VB.Label Label1
         AutoSize        =   -1  'True
         Caption         =   "From"
         Height          =   195
         Left            =   360
         TabIndex        =   16
         Top             =   390
         Width           =   345
      End
   End
   Begin VB.TextBox SelPath
      Height          =   315
      Left            =   600
      TabIndex        =   0
      Top             =   180
      Width           =   5715
   End
   Begin VB.CheckBox DoSubDirs
      Caption         =   "&Process subdirectories of this path"
      Height          =   225
      Left            =   3450
      TabIndex        =   10
      Top             =   3330
      Value           =   1  'Checked
      Width           =   2865
   End
   Begin VB.Frame Frame1
      Caption         =   "Include Files with these Attributes"
      Height          =   1305
      Left            =   3390
      TabIndex        =   13
      Top             =   690
      Width           =   2925
      Begin VB.CheckBox InclAttributes
         Caption         =   "&Hidden"
         Height          =   225
         Index           =   2
         Left            =   270
         TabIndex        =   5
         Tag             =   "2"
         Top             =   900
         Value           =   1  'Checked
         Width           =   1230
      End
      Begin VB.CheckBox InclAttributes
         Caption         =   "&Archive"
         Height          =   225
         Index           =   4
         Left            =   1650
         TabIndex        =   7
         Tag             =   "32"
         Top             =   645
         Value           =   1  'Checked
         Width           =   1020
      End
      Begin VB.CheckBox InclAttributes
         Caption         =   "&System"
         Height          =   195
         Index           =   3
         Left            =   1650
         TabIndex        =   6
         Tag             =   "4"
         Top             =   390
         Value           =   1  'Checked
         Width           =   1050
      End
      Begin VB.CheckBox InclAttributes
         Caption         =   "&Read Only"
         Height          =   225
         Index           =   1
         Left            =   270
         TabIndex        =   4
         Tag             =   "1"
         Top             =   645
         Value           =   1  'Checked
         Width           =   1230
      End
      Begin VB.CheckBox InclAttributes
         Caption         =   "&Normal"
         Height          =   225
         Index           =   0
         Left            =   270
         TabIndex        =   3
         Tag             =   "0"
         Top             =   390
         Value           =   1  'Checked
         Width           =   1230
      End
   End
   Begin VB.CommandButton CancelBtn
      Cancel          =   -1  'True
      Caption         =   "&Cancel"
      Height          =   360
      Left            =   5190
      TabIndex        =   12
      Top             =   3750
      Width           =   1125
   End
   Begin VB.CommandButton OKBtn
      Caption         =   "&OK"
      Default         =   -1  'True
      Height          =   360
      Left            =   3930
      TabIndex        =   11
      Top             =   3750
      Width           =   1125
   End
   Begin VB.DirListBox Dir
      Height          =   3015
      Left            =   120
      TabIndex        =   1
      Top             =   720
      Width           =   3135
   End
   Begin VB.DriveListBox Drive
      Height          =   315
      Left            =   120
      TabIndex        =   2
      Top             =   3780
      Width           =   3135
   End
   Begin VB.Label Label2
      AutoSize        =   -1  'True
      Caption         =   "Path"
      Height          =   195
      Left            =   150
      TabIndex        =   14
      Top             =   240
      Width           =   330
   End
Attribute VB_Name = "SelectDirForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private mModalResult As VbMsgBoxResult      'How did the user leave this form (OK/Cancel)?
Private mSelectedDir As String              'Directory selected in the directory list.
Private mAttributes As Long                 'File attributes selected.
Private mDoSubDirs As Boolean               'Process subdirectories?
Private mFullPath As String                 'Full path and file mask specified.
Private mStartDate As Date                  'Start date for date range of files to process.
Private mEndDate As Date                    'End date for date range of files to process.
'#####################################################
'                 PUBLIC PROPERTIES
'#####################################################
Public Property Get ModalResult() As VbMsgBoxResult
    ModalResult = mModalResult
End Property
Public Property Let Attributes(vData As Long)
    mAttributes = vData
End Property
Public Property Get Attributes() As Long
    Attributes = mAttributes
End Property
Public Property Let ProcessSubDirs(vData As Boolean)
    mDoSubDirs = vData
End Property
Public Property Get ProcessSubDirs() As Boolean
    ProcessSubDirs = mDoSubDirs
End Property
Public Property Let FullPathMask(vData As String)
    mFullPath = vData
End Property
Public Property Get FullPathMask() As String
    FullPathMask = mFullPath
End Property
Public Property Let StartingDate(vData As String)
    mStartDate = vData
End Property
Public Property Get StartingDate() As String
    StartingDate = mStartDate
End Property
Public Property Let EndingDate(vData As String)
    mEndDate = vData
End Property
Public Property Get EndingDate() As String
    EndingDate = mEndDate
End Property
'#####################################################
'                 PUBLIC METHODS
'#####################################################
'------------------------------------------
'  Public sub to default options for a
'  new file spec.
'------------------------------------------
Public Sub DefaultOptions()
    mSelectedDir = CurDir
    If (Right$(mSelectedDir, 1) <> "\") Then mSelectedDir = mSelectedDir & "\"
    Dir.Path = mSelectedDir
    mFullPath = mSelectedDir & "*.*"
    SelPath.Text = mFullPath
    Drive.Drive = Left$(mFullPath, 2)
    mStartDate = CDate("Jan 1 1900")
    mEndDate = CDate("Dec 31 9999")
    StartDate.Text = Format("Jan 1 1900", "m/d/yyyy")
    EndDate.Text = Format("Dec 31 9999", "m/d/yyyy")
    mDoSubDirs = True
    DoSubDirs.Value = vbChecked
    mAttributes = vbNormal + vbReadOnly + vbHidden + vbSystem + vbArchive
    SetAttributes
End Sub
'#####################################################
'                 PRIVATE ROUTINES
'#####################################################
'------------------------------------------
'  User canceled this form.
'------------------------------------------
Private Sub CancelBtn_Click()
    Unload Me
End Sub
'------------------------------------------
'  Change to the directory list.
'------------------------------------------
Private Sub Dir_Click()
    'Update the currently selected directory variable,
    'as well as the entire path text box.
    'As the user selects a new directory in the list,
    'we update the complete file spec edit box with the
    'currently selected directory, while retaining the
    'file mask that was entered (MakeFullPath function).
    mSelectedDir = Dir.List(Dir.ListIndex)
    SelPath.Text = MakeFullPath
End Sub
'------------------------------------------
'  Change to the drive list.
'------------------------------------------
Private Sub Drive_Change()
    Screen.MousePointer = vbHourglass
    Dir.Path = Drive.Drive
    Screen.MousePointer = vbDefault
End Sub
'------------------------------------------
'  Form startup event.
'------------------------------------------
Private Sub Form_Activate()
    On Error Resume Next
    'Assume a cancellation of this form.
    mModalResult = vbCancel
    'Set the controls to the form properties.
    'If this form was started from an Add button,
    'the properties were probably defaulted by calling
    'the DefaultOptions method of this form from the calling
    'form.  If this was launched by an Edit button, the
    'properties should have been initialized to the
    'selections for the file spec highlighted in the list.
    Dir.Path = mSelectedDir
    SelPath.Text = mFullPath
    Drive.Drive = Left$(mSelectedDir, 2)
    StartDate.Text = Format(mStartDate, "m/d/yyyy")
    EndDate.Text = Format(mEndDate, "m/d/yyyy")
    Dir.Path = ExtractFilePath(SelPath.Text)
    If (mDoSubDirs = True) Then
        DoSubDirs.Value = vbChecked
    Else
        DoSubDirs.Value = vbUnchecked
    End If
    'Parse the Long Int of attributes and set the
    'proper checkboxes for each bit.
    SetAttributes
    SelPath.SetFocus
    SelPath.SelStart = 0
    SelPath.SelLength = Len(SelPath.Text)
End Sub
'------------------------------------------
'  Accept the form options (OK button).
'------------------------------------------
Private Sub OKBtn_Click()
    'Validate the dates.  DateTime picker was not used to
    'avoid dependencies on the (huge) Common Controls OCXs.
    If (Not IsDate(StartDate.Text)) Then
        MsgBox "The starting date is not a valid date.", vbExclamation + vbOKOnly, "Invalid Date"
        Exit Sub
    End If
    If (Not IsDate(EndDate.Text)) Then
        MsgBox "The ending date is not a valid date.", vbExclamation + vbOKOnly, "Invalid Date"
        Exit Sub
    End If
    'Fix-up the path edit box and add a drive if missing.
    If (InStr(SelPath.Text, ":") = 0) And (Left$(SelPath.Text, 2) <> "\\") Then
        If (Left$(SelPath.Text, 1) = "\") Then
            SelPath.Text = Left$(Drive.Drive, 2) & SelPath.Text
        Else
            SelPath.Text = Left$(Drive.Drive, 2) & "\" & SelPath.Text
        End If
    End If
    'Set public properties for the caller.
    mModalResult = vbOK
    mDoSubDirs = (DoSubDirs.Value = vbChecked)
    mSelectedDir = ExtractFilePath(SelPath.Text)
    mFullPath = MakeFullPath
    mStartDate = CDate(StartDate.Text)
    mEndDate = CDate(EndDate.Text)
    'Make a Long Int out of the property checkboxes.
    MakeAttributeLong
    Unload Me
End Sub
'------------------------------------------
'  Make a long integer attribute bitmask
'  based on the options selected.
'------------------------------------------
Private Sub MakeAttributeLong()
    Dim C As CheckBox
    mAttributes = 0
    For Each C In InclAttributes
        If (C.Value = vbChecked) Then mAttributes = mAttributes + CInt(C.Tag)
    Next C
End Sub
'------------------------------------------
'  Set the checkboxes based on the
'  options selected in the Long Int
'  bitmask.
'------------------------------------------
Private Sub SetAttributes()
    Dim C As CheckBox
    For Each C In InclAttributes
        If ((mAttributes And C.Tag) = C.Tag) Then
            C.Value = vbChecked
        Else
            C.Value = vbUnchecked
        End If
    Next C
End Sub
'------------------------------------------
'  Create a complete path and file spec
'  based on the currently selected
'  directory and the existing file mask
'  portion of the path in the path edit
'  box.
'------------------------------------------
Private Function MakeFullPath() As String
    Dim RetPath As String
    Dim PathName As String
    Dim FileName As String
    PathName = mSelectedDir
    FileName = Trim(ExtractFileName(SelPath.Text))
    If (FileName = "") Then FileName = "*.*"
    If (Right$(PathName, 1) = "\") Then
        RetPath = PathName & FileName
    Else
        RetPath = PathName & "\" & FileName
    End If
    If (InStr(mSelectedDir, ":") = 0) And (Left$(mSelectedDir, 2) <> "\\") Then RetPath = Left$(Drive.Drive, 2) & RetPath
    MakeFullPath = RetPath
End Function
'------------------------------------------
'  Select the text in the path edit box.
'------------------------------------------
Private Sub SelPath_GotFocus()
    SelPath.SelStart = 0
    SelPath.SelLength = Len(SelPath.Text)
End Sub